{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modInteractionWeb;

interface

uses HttpProt,
     modInteractionFichierUpdate,
     modNewsGestion;

     

const
     // doit être identique qu'en PHP
     PARAM_VAR_NEWS_DATE = 'w';


(*
http://127.0.0.1:200/ru/robot_echange/mirrors1.txt
http://127.0.0.1:200/ru/robot_echange/mirrors2.txt
http://127.0.0.1:200/ru/robot_echange/mirrors3.txt
http://127.0.0.1:200/ru/robot_echange/mirrors4.txt

const
    // avec ces liens, on récupère l'adresse des news
    // et c'est dans la news que l'on donne le lien du nouveau forum par exemple
    CRYPTED_MIRROIR_DL = '';
*)
                         
(*
http://yyyy.fr/yyuuu/gen/up.txt
*)
	// chiffré par la clé privé, lisible par le robot, c'est seulement un moyen pour éviter
	// de mettre les liens en dur (un lien par ligne)
    CRYPTED_MIRROIR_DL = 'oaioSQ3r2eLUJKm7FYB8ezMkiXGhhnt/7G9u/jIMdntDtwp3legylCL3GhLnjKJc' +
                         'GNq4O+u8Cwcb8K4XvufVN6lTJDyf+QyXhtgT7hqj7YGQgvnXAvN8q6iL4c/PjJsJ' +
                         '48FcQyieWj48x2W - altered - IFaQSLogsKScqey7FDqPFM2GtRg7i' +
                         '4TCDsQHkR3js/HX - altered - MkxsHVXrt3nVbSgbcJXC71N0Zg9ZK' +
                         'c3tZnCaYoOUPv8c - altered - aT0EiG8CIyEkWusL0jYU7cpY979lG' +
                         '9Npu+iSb/Mrhbzy - altered - OETIffRNLCLwlW4';



// renvoi une chaine vide si tout les id ont été traité (ou si l'id est trop petit
// le premier id est 0  (utilise la chaine crypté CRYPTED_MIRROIR_DL)
function iwGetMirroirLink(Id: integer): string;


// renvoi nil si échoue
function iwDLFichierMirroir(URL: string): TFichierUpdateParsing;
function iwFindValidMirroirFileAndDLIt(IdStart, NbEssaie: integer): TFichierUpdateParsing;



function iwNewsDownload(URL: string; DateLimit: int64; NewsBD: TNewsCollection): integer;



function iwGenerateUniqueId: int64;
function iwGeneratePassword: string;


function iwGetSocket: THttpCli;
procedure iwFreeSocket;


procedure iwFixeBaliseBR(var PageWeb: string);


var
    iwInteractionSocket: THttpCli;

implementation

uses modGestionDownload,
     modGestionDLGzip,
     modConstantes,
     SysUtils,
     
     modInteractionKey,
     sFonctionsChaines,
     modInteractionAuteur;


type
    TiwErrorFnct = (tiwNone, tiwErrorDL, tiwInvalidWebPage, tiwNotReady);

var
    iwLastResultFnct   : TiwErrorFnct;



function iwNewsDownload(URL: string; DateLimit: int64; NewsBD: TNewsCollection): integer;
var sPageWeb: string;
    i:integer;
begin
    Result := -1;

    iwGetSocket;

    i := 0;
    while iwInteractionSocket.State <> httpReady do begin
       Sleep(1);
       iwInteractionSocket.CtrlSocket.ProcessMessages;
       Inc(i);
       if i > 100 then
          // le socket n'est pas prêt
          // inutile d'essayer de télécharger la page web
          exit;

    end;


    iwInteractionSocket.Cookie := format('%s=%d', [PARAM_VAR_NEWS_DATE, DateLimit]);

    // aucune données à poster lors du DL du fichier
    // la date est fournise en tant que cookies
    sPageWeb := gzhttpGETorPOST_InTamponX(URL, '', iwInteractionSocket);
    
    // réinitialise les cookies
    iwInteractionSocket.Cookie := '';

    if (sPageWeb = modDL_ERREUR_DL_STR) or (sPageWeb = '') or (length(sPageWeb) < 10) then begin
       // echec de téléchargement
       iwLastResultFnct := tiwErrorDL;
       exit;
    end;

    iwFixeBaliseBR(sPageWeb);

    Result := NewsBD.ParsingNews(sPageWeb);


end;


function iwFindValidMirroirFileAndDLIt(IdStart, NbEssaie: integer): TFichierUpdateParsing;
var i, j: integer;
    sURL: string;
begin
    iwGetSocket;

    Result := nil;
    
    if iwInteractionSocket = nil then begin
       // impossible d'avoir un socket
       exit;
    end;

    i := 0;
    while iwInteractionSocket.State <> httpReady do begin
       Sleep(1);
       iwInteractionSocket.CtrlSocket.ProcessMessages;
       Inc(i);
       if i > 100 then
          // le socket n'est pas prêt
          // inutile d'essayer de télécharger la page web
          exit;

    end;


    i := IdStart;

    repeat
        sURL := iwGetMirroirLink(i);

        if sURL = '' then break;

        for j := 0 to NbEssaie do begin
           iwLastResultFnct := tiwNone;

           Result := iwDLFichierMirroir(sURL);

           if Result <> nil then begin
              Result.IdUpdateFile := i;
              break;
           end;
           Sleep(1);

           if iwLastResultFnct = tiwInvalidWebPage then
              // la page web est invalide, inutile de la télécharger
              break;

           if iwInteractionSocket.StatusCode > 400 then begin
              // erreur du serveur (fichier non trouvé, ou accès refusé...)
              // inutile de  télécharger la page à nouveau
              break;
           end;
              
        end;

        Inc(i);

    until Result <> nil;

end;


function iwDLFichierMirroir(URL: string): TFichierUpdateParsing;
var sPageWeb, sClair: string;
    xPos: integer;
begin

    Result := nil;

    // configure le socket
    iwGetSocket;

    if iwInteractionSocket.State <> httpReady then begin
       exit;
    end;

    // réinitialise les cookies
    iwInteractionSocket.Cookie := '';

    
    // aucune données à poster lors du DL du fichier
    sPageWeb := gzhttpGETorPOST_InTamponX(URL, '', iwInteractionSocket);

    if (sPageWeb = modDL_ERREUR_DL_STR) or (sPageWeb = '') or (length(sPageWeb) < 15) then begin
       // echec de téléchargement
       iwLastResultFnct := tiwErrorDL;
       exit;
    end;


    iwFixeBaliseBR(sPageWeb);

    if iaExtractDataBetweenBeginEnd(sPageWeb) then begin

        if length(sPageWeb) > 10 then begin
           // déchiffre
           sClair := iaRSADecryptageKeyStream(sPageWeb, RSA_GetPublicKey, CNT_PUBLICKEY_PASSPHRASE);

           if sClair = '' then begin
              // page invalide
              exit;
           end;

           // analyse le fichier
           Result := TFichierUpdateParsing.Create;

           Result.Parsing(sClair);

           if Result.Version < 1 then begin
              // la version du fichier doit être au moins égale à 1
              Result.Free;
              Result := nil;
           end;

           FillChar(sClair[1], length(sClair), #0);
           sClair := '';

        end;

    end;


end;

procedure iwFreeSocket;
begin
    if iwInteractionSocket <> nil then begin
       iwInteractionSocket.Abort;
       iwInteractionSocket.Free;
       iwInteractionSocket := nil;
    end;
end;

function iwGetSocket: THttpCli;
begin
    if iwInteractionSocket = nil then begin
       iwInteractionSocket := THttpCli.Create(nil);
    end;

    iwInteractionSocket.Accept         := 'image/png,*/*;q=0.5';
    iwInteractionSocket.AcceptLanguage := 'fr, en';
    iwInteractionSocket.Agent          := 'Mozilla/5.0 (compatible) itwb/' + CNT_CURR_VERSION;

    iwInteractionSocket.Connection      := 'Close';
    iwInteractionSocket.ProxyConnection := 'Close';
    iwInteractionSocket.RequestVer      := '1.1';


end;


function iwGetMirroirLink(Id: integer): string;
var strList: string;
    i: integer;
    xPos : integer;
begin

    Result := '';

    if id < 0 then exit;

    // décrypte
    try
      strList := iaRSADecryptageKeyStream(CRYPTED_MIRROIR_DL, RSA_GetPublicKey, CNT_PUBLICKEY_PASSPHRASE);
    except
      strList := '';
    end;

    i := 0;
    while (strList <> '') do begin

       xPos := pos(#$0A, strList);
       if xPos = 0 then begin
          if i = id then begin
             Result := trim(strList);
             break;
          end;

          // nettoie avec des 0 puis supprime
          FillChar(strList[1], length(strList), #0);
          strList := '';
       end else begin
          if i = id then begin
             Result := trim(copy(strList, 1, xPos - 1));
             break;
          end;

          // nettoie avec des 0
          FillChar(strList[1], xPos, #0);

          // puis supprime
          System.Delete(strList, 1, xPos);

          strList := trim(strList);
       end;

       Inc(i);
    end;

    // nettoie la liste
    if strList <> '' then
       FillChar(strList[1], length(strList), #0);

end;


function Sock45_Gen_NombreInt64: int64;
var CurrByte: byte;
    i: integer;
begin
    Result := 0;

    Randomize;

    for i := 0 to 6 do begin
       CurrByte := Random(256);
       Result := Result or CurrByte;
       Result := Result shl 8;
       Sleep(CurrByte mod 5);
    end;

    // octet de poid faible:
    CurrByte := Random(255);
    Result := Result or CurrByte;
end;

function iwGenerateUniqueId: int64;
begin
   Result := Sock45_Gen_NombreInt64;
   Result := Result + Sock45_Gen_NombreInt64;
end;


function iwGeneratePassword: string;
const
  LettreAllow = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
var i, k: integer;
begin
    SetLength(Result, 16);

    for i := 1 to length(Result) do begin
        k := Random(length(LettreAllow))+ 1;

        Result[i] := LettreAllow[k];
        Sleep((k mod 3) + 1);
    end;

end;

procedure iwFixeBaliseBR(var PageWeb: string);
begin
    PageWeb := sfcRemplace(PageWeb, '<br>', #$0A);
    PageWeb := sfcRemplace(PageWeb, '<br />', #$0A);
    PageWeb := sfcRemplace(PageWeb, '<BR>', #$0A);

end;


initialization
     iwInteractionSocket := nil;

finalization
     iwFreeSocket;


end.
